perm filename TMP[GEM,BGB] blob
sn#088726 filedate 1974-03-03 generic text, type T, neo UTF8
SUBR(SLICE0,BDYSET) ;SLICE A SET OF BODIES AT ZCUT LEVEL.
;--------------------------------------------------------------------
;INITIALIZATION.
DZM ELIST2 ;LIST OF LISTS OF SHORT EDGES.
DZM FSET1 ;LIST OF PZ SLICE FACES.
;LOOP FOR CUTTING BODIES OF THE BODY SET.
LAC 1,BDYSET↔SON 1,1↔DAC 1,B0↔DAC 1,B ;INIT THE LOOP.
L1: CALL(VMARK,B) ;MARK VERTICES PZ & NZ.
SKIPN PZCNT↔GO .+3 ;PIECE FULLY BELOW.
SKIPE NZCNT↔GO[CALL(FECUT,B)↔GO .+1] ;CUT FACES AND EDGES.
LAC 1,B↔BRO 2,1↔DAC 2,B ;ADVANCE ALONG BODY RING.
SKIPN PZCNT↔GO[CALL(KLBFEV,1)↔GO .+1] ;KILL PIECE FULLY BELOW.
LAC 1,B↔CAME 1,B0↔GO L1 ;...AND FALL THRU.
;--------------------------------------------------------------------
;SLICE THE SOLID - MAPCAR UNGLUE DOWN THE ALT2 EDGE LIST 2.
L2: SKIPN 2,ELIST2↔GO L5
ALT2 1,2↔DAC 1,ELIST2
DAC 2,ELIST1
;KILL THE TIES THAT BIND - MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L3: SKIPN 2,ELIST1↔GO L4
ALT 1,2↔DAC 1,ELIST1
PFACE 0,2↔DAC 0,FACE1
SETQ(FACE2,{KLFE,2})↔GO L3
;PLACE THE NEW FACES OF THE SLICE INTO A RING.
L4: LAC 1,FACE1↔LAC 2,FACE2↔ALT. 1,2↔ALT. 2,1 ;TWO NEW FACES.
TEST 1,PZ↔EXCH 1,2↔SKIPE 4,FSET1↔GO .+5 ;THE PZ FACE.
DIP 1,8(1)↔DAP 1,8(1)↔DAC 1,FSET1↔GO L2 ;SELF RING.
CAR 3,8(4)↔DAP 1,8(3)↔DIP 3,8(1) ;RING IN.
DAP 4,8(1)↔DIP 1,8(4)↔GO L2
;--------------------------------------------------------------------
;UPDATE SET OF POSITIVE BODIES IN BSET1.
L5: LAC 1,FSET1↔DAC 1,FACE1
L6: LAC 1,FACE1↔CDR 1,8(1)↔DAC 1,FACE1 ;ADVANCE CUT-FACE RING.
PED 1,1↔CCW 1,1↔CALL(BATT,1,BSET1)
LAC 1,FACE1↔CAME 1,FSET1↔GO L6↔POP1J
DECLARE{EDGE,FACE1,FACE2,B,B0}
ENDR SLICE0;1/12/74(BGB)---------------------------------------------
SUBN(VMARK,BODY) ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
;--------------------------------------------------------------------
ACCUMULATORS{V,PDEL,NDEL,E,E0}
;CLEAR THE NZ AND PZ BITS OF ALL THE EDGES AND VERTICES.
DZM PZCNT↔DZM NZCNT
LACI PZ+NZ↔LAC 1,BODY
ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
ANDCAM(1)↔PED 1,1↔CAME 1,BODY↔GO .-3
;POSITIVE AND NEGATIVE EPSILON.
LAC PDEL,ZCUT↔FADR PDEL,[0.01]
LAC NDEL,ZCUT↔FSBR NDEL,[0.01]
;FORCE THE VERTICES TO BE ABOVE OR BELOW THE SLICE PLANE.
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
L2: LAC ZWC(V)
CAML PDEL↔GO[MARK V,PZ↔AOS PZCNT↔GO L3]
CAMG NDEL↔GO[MARK V,NZ↔AOS NZCNT↔GO L3]
FSBR ZCUT
SKIPL ↔DAC PDEL,ZWC(V)
SKIPGE↔DAC NDEL,ZWC(V)↔GO L2
;MARK THE EDGES OF THIS VERTEX AS PZ OR NZ.
L3: PED E,V↔LAC E0,E
L4: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L5 ;AC1 ← ECCW(E,V).
NVT 1,E↔CAME 1,V↔GO L1 ↔NCW 1,E
L5: IORM 0,(E)↔LAC E,1 ;AC0 CONTAINS THE BIT.
CAME E,E0↔GO L4↔GO L1
ENDR VMARK;1/11/74(BGB)---------------------------------------------
DECLARE{PZCNT,NZCNT}
SUBN(FECUT,BODY) ;FACE EDGE CUTTING.
;--------------------------------------------------------------------
ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
LAC 1,BODY↔DAC 1,EDGE#
L0: LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE ;ADVANCE ALONG EDGE RING.
CAMN 1,BODY↔POP1J ;TEST FOR END OF EDGE RING.
TEST 1,PZ↔GO L0 ;TEST FOR EDGE CROSSING.
TEST 1,NZ↔GO L0
;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
DOM FLAG ;FIRST TIME THRU FLAG -1.
DZM ELIST1 ;LIST OF VERY SHORT EDGES.
LAC 1,EDGE
DAC 1,E↔NVT 2,1↔TEST 2,PZ
GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZ HALF-SPACE.
LAC 1,E↔NFACE 1,1
DAC 1,F0↔DAC 1,F ;FIRST FACE.
;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1: LAC 1,E↔MARKZ 1,PZ+NZ
NVT V1,1↔PVT V2,1↔PUSH P,V2↔PUSH P,V1 ;SAVE OLDE VERTICES.
TEST V1,PZ↔GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZZ.
SETQ(U2,{ESPLIT,E})↔MARK 1,PZ ;PZ HALFSPACE.
PED 1,1
LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1 ;CONS EDGE INTO ELIST1.
SETQ(UU2,{ESPLIT,ELIST1})↔MARK 1,NZ ;NZ HALFSPACE.
;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
POP P,V1↔POP P,V2 ;RESTORE OLDE VERTICES.
LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
LAC ZCUT↔FSBR ZWC(V1)↔FDVR DZ↔LAC 2,U2 ;COEFFICIENT K.
FMPR DX,0↔FADR DX,XWC(V1)↔DAC DX,XWC(1)↔DAC DX,XWC(2)
FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)
;FIRST TIME ONLY.
AOSG FLAG↔GO[
LAC U2↔DAC U0
LAC UU2↔DAC UU0↔GO L2]
;DOUBLE FACE SPLIT.
CALL(MKFE,U2,F,U1)
NFACE 1,1
CALL(MKFE,UU2,1,UU1)
;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2: LAC U2↔DAC U1↔LAC UU2↔DAC UU1
SETQ(F,{OTHER,E,F})
CAMN 1,F0↔GO L4
L3: SETQ(E,{ECCW,E,F})
TEST 1,NZ↔GO L3
GO L1
;DOUBLE CUT LAST (FIRST) FACE.
L4: CALL(MKFE,U0,F,U1)
NFACE 1,1
CALL(MKFE,UU0,1,UU1)
;CONS ELIST1 INTO ELIST
LAC 1,ELIST1↔LAC 2,ELIST2
ALT2. 2,1↔DAC 1,ELIST2↔GO L0
DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------